perm filename FILLER.SAI[XGP,TES] blob
sn#027191 filedate 1973-02-22 generic text, type T, neo UTF8
00100 ENTRY TEXTLINE ;
00200 BEGIN "FILLER"
00300
00400 DEFINE TERNAL = "EXTERNAL" , PRELOAD = "COMMENT" ;
00500 REQUIRE "PUBDFS.SAI" SOURCE_FILE ;
00600 REQUIRE "PUBMAI.SAI[A700PU00]" SOURCE_FILE ;
00700 BEGIN "INNER BLOCK"
00800 REQUIRE "PUBINR.SAI[A700PU00]" SOURCE_FILE ;
00900 REQUIRE "PUBPRO.SAI[A700PU00]" SOURCE_FILE ;
01000
01100 comment, the following EXTERNAL SIMPLE PROCEDUREs are INTERNAL in PARSER.SAI ;
01200
01300 EXTERNAL STRING SIMPLE PROCEDURE RD(INTEGER BRKTBL) ;
01400
01500 EXTERNAL RECURSIVE STRING PROCEDURE PASS ;
01600
01700 EXTERNAL RECURSIVE STRING PROCEDURE E(STRING DEFAULT, STOPWORD) ;
01800
01900 EXTERNAL STRING SIMPLE PROCEDURE VEVAL ;
02000
02100 EXTERNAL STRING SIMPLE PROCEDURE EVALV(STRING THISWD ; INTEGER IX, TYP) ;
02200
02300 FORWARD RECURSIVE PROCEDURE BOUND(INTEGER KIND) ;
00100 COMMENT T H E L I N E F I L L E R
00200
00300 These routines build a first pass output line in string OWL
00400 and then call the line placer (PLACELINE()) to place it in an area.
00500 OWL is kept lengthy enough to hold any first pass output line.
00600 That way, a line can be constructed by IDPB'ing (with APPEND())
00700 inside OWL instead of by numerous concatenations.
00800 Characters in OWL[1 TO OAKS] belong to the current line being
00900 built. However, some of these characters describe FONT changes or
01000 forward label references and others mark word breaks or CR to the
01100 left margin for superimposing. Thus, the line reaches only to
01200 column POSN (relative to the left edge of the area), and FAKE of
01300 these columns are not occupied but are only allocated for forward
01400 references. Furthermore, in FILL mode, the last permissible point
01500 after which the line can be broken by a CrLf is marked by four
01600 variables: BRKPT, BRKPOSN, BRKSPCS, and BRKFAKE, which contain the
01700 values of OAKS, POSN, and FAKE at that point, and the number of
01800 delible spaces right after that point. Though there is normally a
01900 WDBRK character at the breakpoint, there may be none if it is the
02000 first breakpoint on the line or if it was caused by a hyphen.
02100 TEXTLINE sets up the input stream for processing by PROCESS.
02200 PROCESS scans it up to a {, cr, or altmode, obeying all control
02300 characters and EMITting all regular characters. EMIT calls APPEND
02400 after checking for line overflow, etc. Spaces are PROCESSed
02500 differently -- instead of calling EMIT to APPEND them immediately,
02600 EMSPACES is called, which just counts up spaces in SPCS and handles
02700 COMPACTion and punctuation problems. Thus, when EMIT is called, it
02800 must append SPCS spaces before appending its argument. ;
02900
03000 SIMPLE PROCEDURE APPEND(STRING CHARS) ;
03100 IF ON THEN
03200 BEGIN
03300 STRING D ; INTEGER CCT, BALANCE ;
03400 DEFINE SRC="'15", COUNT="'14", DEST="'13", CHAR="'11" ;
03500 CCT ← LENGTH(CHARS) ;
03600 IF (BALANCE ← LENGTH(OWL) - (OAKS+CCT)) < 0 THEN
03700 OWL ← OWL & SPS((1-BALANCE)*2) ;
03800 IF CCT > 0 THEN
03900 BEGIN
04000 LABEL IUD ; COMMENT DEPOSIT LOOP ;
04100 D ← OWL[OAKS+1 FOR 1] ;
04200 START_CODE "APPD"
04300 MOVE SRC, CHARS ;
04400 HRRZ COUNT, CCT ;
04500 ADDM COUNT, OAKS ;
04600 MOVE DEST, D ;
04700 IUD: ILDB CHAR, SRC ;
04800 IDPB CHAR, DEST ;
04900 SOJG COUNT, IUD ;
05000 END "APPD"
05100 END ;
05200 END "APPEND" ;
00100 INTERNAL STRING SIMPLE PROCEDURE LABELREF(INTEGER USYMB, LEN) ;
00200 IF ¬ON THEN RETURN(NULL) ELSE
00300 BEGIN
00400 INTEGER PTR, PLIGHT, WASSYMB ; STRING S ;
00500 IF NULSTR(THISWD) THEN ie, Generated Label for {PAGE⎇. USYMB=0.;
00600 PTR ← (PLBL ← PUTI(1, PLBL)) LOR 2↑14 ie Add to Linked List ;
00700 ELSE IF BYTEWD ← NUMBER[ PTR ← SYMNUM(THISWD & ":") ] THEN
00800 BEGIN "KNOWN LABEL"
00900 CASE (PLIGHT ← LDB(PLIGHTWD(BYTEWD))) MOD 3 OF
01000 BEGIN COMMENT BY PLIGHT ;
01100 ie 0 or 3 ... Page Label still Uncertain ; WASSYMB ← SYMPAGE ;
01200 ie 1 ... Referenced but not defined ; WASSYMB ← LDB(IXWD(BYTEWD)) ;
01300 ie 2 ... Defined and Certain ;
01350 BEGIN
01352 BREAKSET(LOCAL_TABLE,ALTMODE,"IS");
01354 BREAKSET(LOCAL_TABLE,NULL,"O");
01375 S ← STBL[LDB(IXWD(BYTEWD))] ;
01380 RETURN (SCAN(S,LOCAL_TABLE,DUMMY));
01385 END;
01400 END ; COMMENT BY PLIGHT ;
01500 IF USYMB AND LDB(IXN(USYMB)) ≠ LDB(IXN(WASSYMB)) THEN
01600 BEGIN "DIFFERENT UNIT"
01700 IF WASSYMB THEN WARN("X-REF ERROR","Label "&SYM[PTR]&
01800 " was cross-referenced as a "&SYM[WASSYMB]&
01900 " earlier, but now as a "&SYM[USYMB]) ;
02000 IF PLIGHT = 1 THEN NUMBER[PTR] ← 1 ROT -2 LOR USYMB ;
02100 END "DIFFERENT UNIT" ;
02200 END "KNOWN LABEL"
02300 ELSE NUMBER[PTR] ← 1 ROT -2 LOR USYMB ;
02400 RETURN(RUBOUT & CVS(LEN) & VT & CVS(PTR) & VT) ;
02500 END "LABELREF" ;
00100 SIMPLE PROCEDURE OKSP(BOOLEAN EVEN_BEFORE_LMARG) ;
00200 IF LASTWDBRK ≠ OAKS AND ON AND
00300 JUSTIFY AND (POSN<MAXIM OR XCRIBL) AND (EVEN_BEFORE_LMARG OR POSN > 0 MAX INDENT) THEN
00400 BEGIN APPEND(WDBRK) ; LASTWDBRK ← OAKS ; END ;
00500
00600 SIMPLE PROCEDURE OKCR(BOOLEAN EVEN_IN_SUPERSUBSCRIPT) ;
00700 IF BRKPT≠OAKS AND ON AND (SUPERSUB=0 OR EVEN_IN_SUPERSUBSCRIPT) THEN
00800 BEGIN
00900 BRKPT ← OAKS ; BRKPOSN ← POSN ; BRKFAKE ← FAKE ; BRKPLBL ← PLBL ; BRKSPCS ← 0 ;
00950 BRKXPOSN ← XPOSN ;
01000 IF SUPERSUB THEN RETURN ;
01100 BRKABX ← BRKABX MAX ABOVEX ; BRKBLX ← BRKBLX MIN BELOWX ; ABOVEX←BELOWX←0 ;
01200 END "OKCR" ;
01300
01400
01500 RKJ START;
01600 INTERNAL INTEGER PROCEDURE XLENGTH(STRING CHARS);
01700 BEGIN "XL"
01800 INTEGER COUNT;
01900 IF NOT XCRIBL THEN RETURN(0); COMMENT IF NOT IN XCRIBL MODE THEN WE DON'T NEED THIS VALUE;
02000 COUNT←0;
02100 WHILE FULSTR(CHARS) DO
02200 COUNT ← COUNT + CW[KSETCON + LOP(CHARS)];
02300 RETURN (COUNT);
02400 END;
02500
02600 INTEGER PROCEDURE XSPLEN(INTEGER N);
02700 RETURN(N * CW[KSETCON + SP]);
02800
02900 RKJ END;
00100 RECURSIVE PROCEDURE EMIT(STRING CHARS) ;
00200 IF ON THEN
00300 BEGIN
00400 INTEGER NCHARS, EXCHARS, WASBRC ; STRING EXCESS ; LABEL ADDIT ; comment Sorry about that ;
00500 INTEGER XCHARL,XSPCL; RKJ;
00600 NCHARS ← LENGTH(CHARS) ;
00700 XCHARL ← XLENGTH(CHARS); RKJ;
00800 XSPCL ← XSPLEN(SPCS) ; RKJ;
00900 RKJ: OLD LINE IF POSN + SPCS + NCHARS ≤ MAXIM THEN comment, no overfow ;
01000 IF (IF XCRIBL THEN (XPOSN+XSPCL+XCHARL≤(MAXIM*CHARW)) ELSE (POSN+SPCS+NCHARS≤MAXIM)) THEN comment no overflow;
01100 ADDIT:
01200 BEGIN
01210 IF SPCS AND XCRIBL AND (FILL AND ADJUST) THEN
01220 BEGIN FSHORT←FSHORT+XSPLEN(1); SPCS←SPCS-1 END;
01300 IF SPCS THEN BEGIN APPEND(SPS(SPCS)) ; BRKSPCS ← SPCS END ;
01400 APPEND(CHARS) ; POSN ← POSN + SPCS + NCHARS ; SPCS ← 0 ;
01500 XPOSN ← XPOSN + XSPCL + XCHARL; RKJ;
01600 END
01700 ELSE IF FILL AND BRKPT > INDENT THEN comment, go back to a break point ;
01800 BEGIN
01900 IF BRKPT=OAKS THEN BEGIN XSPCL ← SPCS ← EXCHARS ← 0 ; EXCESS ← NULL END
02000 ELSE BEGIN EXCESS←OWL[BRKPT+1+BRKSPCS TO OAKS]; COPY(EXCESS);
02100 EXCHARS←POSN-BRKPOSN-BRKSPCS END;
02200 FAKE ← FAKE - BRKFAKE ; NOPGPH ← -1 ; WASBRC ← BRC ;
02300 OAKS ← BRKPT ; BOUND(3) ; COMMENT ADDED 4/14/72 ;
02400 PLACELINE(IF OWL[OAKS FOR 1]=WDBRK THEN OAKS-1 ELSE OAKS, BRKPOSN MIN MAXIM, BRKXPOSN-FSHORT,
02500 BRKFAKE, BRKABX, -BRKBLX, IF FIRST THEN LEADFM ELSE SPREADM-1,
02600 BRKPLBL, ADJUST, SPREADM) ;
02700 FSHORT ← NOPGPH ← OAKS ← TABI ← BRKABX ← BRKBLX ← STARPOSN ← AMPPOSN ← LASTWDBRK ← 0 ; BRC←WASBRC;
02800 IF FIRST THEN BEGIN
02900 INDENT ← RESTIM MAX -LMARG ; FIRST ← FALSE ;
03000 END ;
03100 POSN ← INDENT ; APPEND(SPS(LMARG + POSN)) ; OKCR(TRUE) ;
03200 IF UNDERLINING THEN IF NOT XCRIBL THEN APPEND(FONTCHAR&"_") ;
03300 XPOSN ← XSPLEN(LMARG + POSN) + XLENGTH(EXCESS); RKJ;
03400 APPEND(EXCESS) ; POSN ← POSN + EXCHARS ;
03500 IF SPCS THEN BEGIN OKSP(FALSE) ; OKCR(FALSE) END ;
03600 GO TO ADDIT ;
03700 END
03800 ELSE IF POSN≤MAXIM THEN comment, About to overflow right edge of area! ;
03900 BEGIN
04000 APPEND((SPS(SPCS)&CHARS)[1 TO MAXIM - POSN]) ;
04100 WARN("Line too long","Line too long -- characters lost:"&CHARS[MAXIM-POSN+1 TO ∞]&"...") ;
04200 POSN ← MAXIM+1 ; SPCS ← 0 ;
04300 XPOSN ← XMAXIM + 1; RKJ;
04400 END ;
04500 MIDWORD ← MIDWORD OR FULSTR(CHARS) ; PUNC ← FALSE ;
04600 END "EMIT" ;
00100 RECURSIVE PROCEDURE BOUND(INTEGER KIND) ;
00200 IF ON THEN
00300 BEGIN
00400 INTEGER LB, RB, DEST, FILLIN, XLB, XFILLIN ;
00500 LABEL SLIDEFILL, TABFILL, TABCASE ; STRING FILLER, BOUNDS ;
00600 STRING SEGMENT ;
00700 COMMENT KIND ≤ 0 ... ∞X (The ASCII of X negated)
00800 = 1 ... ←
00900 = 2 ... →
01000 = 3 ... CR or BREAK
01100 = 4 ... Tab (\ or ∂) ;
01200 IF KIND=3 OR KIND=4 AND NULSTR(LBF) THEN SPCS ← 0 ELSE EMIT(NULL) ;
01300 OKCR(TRUE) ; comment added 4/17/72 ;
01400 Comment An earlier BOUND on this line may have set LBK←KIND ;
01500 IF LBK < 3 THEN CASE LBK MAX 0 OF
01600 BEGIN COMMENT BY KIND ;
01700 ie ≤ 0 ... ∞ Only valid if immediately preceding this Bound ;
01800 IF LBO < OAKS ∨ SPCS THEN
01900 BEGIN
02000 WARN("=","∞ needs a right bound") ;
02100 LBF ← NULL ;
02200 END ;
02300 ie = 1 ... ← Center between left bound at POSN=LBP and this TAB to RBOUND, or between margins ;
02400 BEGIN "CENTER"
02500 IF KIND=4 THEN BEGIN XLB←XLBP ; LB←LBP ; RB←RBOUND END
02600 ELSE BEGIN LB←XLB←0 ; RB←RMARG-LMARG END ;
02700 BOUNDS ← IF NOT XCRIBL THEN (CVSR(LMARG+RB) & CVSR(LMARG+LBP-LB)) ELSE ALTMODE ;
02800 FILLIN ← ((RB - POSN) - (LBP - LB)) DIV 2 ; COMMENT UPPER BOUND ESTIMATE ;
02850 XFILLIN ← ((CHARW*RB - XPOSN) - (XLBP - XLB)) DIV 2 ; COMMENT UPPER BOUND ESTIMATE ;
02900 SLIDEFILL:
03000 SEGMENT ← OWL[LBO+1 TO OAKS] ; COPY(SEGMENT) ; OAKS ← LBO ; FILLER ← OLBF ;
03100 TABFILL:
03200 APPEND(FONTCHAR & "→") ; APPEND(BOUNDS) ;
03250 IF XCRIBL THEN APPEND(CVSR(XFILLIN)) ;
03275 APPEND(FILLER & ALTMODE) ;
03300 APPEND(SEGMENT) ; APPEND(FONTCHAR & "←") ;
03400 POSN ← POSN + (FILLIN MAX 0) ;
03500 XPOSN ← XPOSN + (XFILLIN MAX 0) ;
03700 END "CENTER" ;
03800 ie 2 ... → Right flush against TAB to RBOUND or against right margin ;
03900 BEGIN "RIGHT FLUSH"
04000 RB ← IF KIND=4 THEN RBOUND ELSE RMARG-LMARG ;
04100 FILLIN ← RB - POSN ; BOUNDS ← IF NOT XCRIBL THEN (CVSR(LMARG+RB) & CVSR(-1000)) ELSE ALTMODE ;
04150 XFILLIN ← CHARW*RB - XPOSN ;
04200 GO TO SLIDEFILL ;
04300 END "RIGHT FLUSH" ;
04400 END ; COMMENT BY KIND ;
04500 IF KIND=3 ∧ FULSTR(LBF) THEN BEGIN RBOUND ← RMARG ; GO TO TABCASE END ;
04600 IF KIND=4 THEN
04700 BEGIN "TAB"
04800 IF FULSTR(LBF) THEN
04900 TABCASE: BEGIN
04950 IF XCRIBL THEN WARN("=","∞ not implemented for XGP");
05000 FILLIN ← RBOUND - POSN ; BOUNDS ← CVSR(LMARG+RBOUND) & CVSR(-1000) ;
05100 FILLER ← LBF ; SEGMENT ← NULL ; KIND ← KIND + 2 ; GO TO TABFILL ;
05200 END
05300 ELSE APPEND(FONTCHAR&"="&CVSR("IF XCRIBL THEN CHARW*(RBOUND+LMARG) ELSE RBOUND+LMARG"));
05400 POSN ← RBOUND ; XPOSN ← RBOUND * CHARW ;
05600 END "TAB" ;
05700 IF KIND > 4 THEN KIND ← KIND - 2 ; COMMENT CORRECTS `KIND←KIND+2' ABOVE ↑↑↑↑↑↑↑ ;
05800 IF KIND = 4 AND POSN > MAXIM THEN MAXIM ← NMAXIM+LMARG
05900 ELSE IF FILL THEN MAXIM ← IF KIND ≤ 2 THEN NMAXIM ELSE FMAXIM ;
06000 IF KIND = 3 THEN LBP ← LBO ← 0 ELSE
06100 BEGIN
06200 comment Finally, set Left Bound for a subsequent BOUND ;
06300 LBO ← OAKS ; LBP ← POSN ; XLBP ← XPOSN ; LBK ← KIND ; MIDWORD ← FALSE ;
06400 CASE ((KIND+1) MAX 0) DIV 2 OF BEGIN LBF←LBF&(-KIND) ; BEGIN OLBF←LBF ; LBF←NULL END ; OLBF←LBF←NULL END ;
06500 END ;
06600 END "BOUND" ;
00100 INTERNAL RECURSIVE PROCEDURE DBREAK ;
00200 IF ON THEN IF NOPGPH THEN NOPGPH ← -1 ELSE
00300 BEGIN INTEGER STTS ;
00400 NOPGPH ← -1 ;
00500 BOUND(3) ;
00600 IF POSN > INDENT OR VERBATIM THEN
00700 BEGIN "A PGPH"
00800 PLACELINE(IF LASTWDBRK=OAKS THEN OAKS-1 ELSE OAKS, POSN MIN MAXIM, MAXIM*CHARW-FSHORT,
00900 FAKE, ABOVEX MAX BRKABX,
01000 -(BELOWX MIN BRKBLX),
01100 IF NOFILL THEN LEADNM ELSE IF FIRST THEN LEADFM ELSE SPREADM-1,
01200 PLBL, IF XCRIBL AND ADJUST THEN TRUE ELSE JUSTJUST, 0) ;
01300 FSHORT ← SINCELFM ← 0 ;
01400 IF ENDCASE=2 THEN BEGIN STTS←STARTS; IF ENDBLOCK THEN WARN("=","Missed END in Response|Footnote");
01500 STARTS ← STARTS + STTS ; END ;
01600 END "A PGPH" ;
01700 END "DBREAK" ;
01800
01900 SIMPLE PROCEDURE EMSPACES(INTEGER N) ;
02000 IF ON THEN BEGIN
02100 IF SPCS=0 THEN BEGIN OKSP(FALSE) ; OKCR(FALSE) END ; MIDWORD ← FALSE ;
02200 SPCS ← IF COMPACT THEN (SPCS+N) MIN (IF PUNC THEN 2 ELSE 1) ELSE SPCS+N ;
02300 END "EMSPACES" ;
02400
02500 RECURSIVE PROCEDURE TABTO(INTEGER POSNO) ;
02600 IF ON THEN
02700 IF POSNO≤POSN THEN WARN("=","Already passed tab column " & CVS(POSNO))
02800 ELSE IF POSNO>NMAXIM+LMARG THEN
02900 WARN("=","No such tab column "&(IF POSNO>2↑15 THEN NULL ELSE CVS(POSNO)))
03000 ELSE
03100 BEGIN
03200 RBOUND ← POSNO-1 ;
03300 IF TRUE COMMENT NOFILL ; THEN BOUND(4)
03400 ELSE BEGIN EMIT(NULL);
03410 APPEND(FONTCHAR&"="&CVSR("IF XCRIBL THEN CHARW*(RBOUND+LMARG) ELSE RBOUND+LMARG"));
03420 POSN←RBOUND;
03430 END ;
03500 END "TABTO" ;
03600
03700 RECURSIVE BOOLEAN PROCEDURE ATLEAD(INTEGER LEADSPACES) ;
03800 BEGIN
03900 IF FINDINSET(LEADSPACES) AND FULSTR("SSTK[BODY(LLTHIS)]")THEN RESPOND(LLTHIS)
04000 ELSE RETURN(FALSE) ;
04100 RETURN(TRUE) ;
04200 END "ATLEAD" ;
04300
04400 BOOLEAN SIMPLE PROCEDURE SIGNA(INTEGER SIGCH1) ;
04500 BEGIN
04600 INTEGER ARG, RIX, ARGS, SEPS ; STRING SEE ;
04700 SEE ← SIGCH1 & INPUTSTR ;
04800 LLSCAN(SIGNALD[SIGCH1], NEXT_RESP, "CVASC(SEE[1 FOR CLUE(LLTHIS)])=SIGNAL(LLTHIS)") ;
04900 IF LLTHIS = 0 THEN RETURN(FALSE) ; RIX ← LLTHIS ; ARGS ← NUMARGS(RIX) ;
05000 INPUTSTR ← INPUTSTR[CLUE(RIX) TO ∞] ;
05100 IF ARGS THEN BEGIN "SCAN ARGS"
05200 SEPS ← RESP_SEP(RIX) ; IF LAST + ARGS > SIZE THEN GROWNESTS ;
05300 FOR ARG ← 1 THRU ARGS DO
05400 BEGIN "SEPBREAK"
05500 SETBREAK(LOCAL_TABLE,
05600 (SEPS LSH ((ARG-ARGS)*7) LAND '177) & CRLF, NULL, "IS") ;
05700 SEE ← NULL ;
05800 DO BEGIN
05900 SEE ← SEE & RD(LOCAL_TABLE) ;
06000 IF BRC = CR THEN
06100 BEGIN
06200 IF FULSTR("RD(TO_NON_SP)") ∨ BRC≠"⎇"
06300 CMU CHANGE: STANFORD 176 WENT TO CMU 175 ABOVE;
06400 ∨ INPUTSTR[2 FOR 1]≠VT THEN DONE ;
06500 LOPP(INPUTSTR) ; LOPP(INPUTSTR) ; IF FULSTR(SEE) THEN SEE ← SEE & SP ;
06600 END
06700 ELSE BRC ← -1 ;
06800 END UNTIL BRC < 0 ;
06900 SNEST[LAST + ARG] ← SEE ;
07000 IF BRC > 0 THEN
07100 BEGIN
07200 WARN("=","Missing Signal Separator") ;
07300 FOR ARG ← ARG+1 THRU ARGS DO SNEST[LAST+ARG] ← NULL ;
07400 END ;
07500 END "SEPBREAK" ;
07600 LAST ← LAST + ARGS ; SAT(SNEST, LAST) ;
07700 END "SCAN ARGS" ;
07800 RESPOND(RIX) ; RETURN(TRUE) ;
07900 END "SIGNA" ;
00100 SIMPLE PROCEDURE UNSCRIPT(INTEGER ARROW) ;
00200 BEGIN
00300 INTEGER CHR, PN ; BOOLEAN MORE, WILLRIPT ;
00400 IF ARROW = 0 THEN
00500 BEGIN COMMENT "]" -- find matching "[" ;
00600 ARROW ← SUPERSUB LAND '177 ;
00700 AMPPOSN ← AMPPOSN LSH -9 ; COMMENT 3/28/72 ;
00800 SUPERSUB ← SUPERSUB LSH -9 ;
00900 END ;
01000 IF POSN ≤ MAXIM OR XCRIBL THEN
01100 BEGIN
01200 EMIT(NULL) ;
01300 IF ARROW ≠ "." THEN
01400 BEGIN
01500 APPEND(FONTCHAR & ("↑"+"↓" - ARROW)) ;
01600 HEIGHT ← HEIGHT - (IF ARROW="↑" THEN 1 ELSE -1) ;
01700 END ;
01800 END ;
01900 WILLRIPT ← TRUE ; comment assume that RIPTPOSNS will be updated by SCRIPT if necessary ;
02000 IF LDB(SPCODE(INPUTSTR)) = AMSAND THEN
02100 BEGIN
02200 LOPP(INPUTSTR) ;
02300 MORE ← TRUE ; PN ← RIPTPOSNS LAND '177 - LMARG ; COMMENT 3/28/72: ;
02400 AMPPOSN ← ((AMPPOSN LSH -9) LSH 9) LOR ((AMPPOSN LAND '177) MAX POSN) ;
02500 IF PN<POSN THEN BEGIN APPEND(FONTCHAR&"-"&CVSR(POSN-PN)) ; POSN←PN END ;
02600 IF (CHR ← LDB(SPCODE(INPUTSTR))) = LBRACK THEN
02700 BEGIN
02800 SUPERSUB ← SUPERSUB LSH 9 LOR "." ;
02900 LOPP(INPUTSTR) ; WILLRIPT ← FALSE ; comment not a ript: won't call SCRIPT! ;
03000 END
03100 ELSE IF CHR≠UARROW AND CHR≠DARROW THEN BEGIN EMIT(LOP(INPUTSTR)) ; MORE ← FALSE END ;
03200 END
03300 ELSE MORE ← FALSE ;
03400 IF ¬MORE THEN BEGIN COMMENT 3/28/72: ;
03500 PN ← (AMPPOSN LAND '177) MAX POSN ; AMPPOSN ← (AMPPOSN LSH -9) LSH 9 ;
03600 IF PN>POSN THEN BEGIN APPEND(FONTCHAR&"+"&CVSR(PN-POSN)) ; POSN←PN END END ;
03700 IF WILLRIPT THEN RIPTPOSNS ← RIPTPOSNS LSH -9 ;
03800 END "UNSCRIPT" ;
03900
04000 SIMPLE PROCEDURE SCRIPT(INTEGER ARROW) ;
04100 BEGIN
04200 INTEGER CHR ;
04300 CHR ← LOP(INPUTSTR) ;
04400 HEIGHT ← HEIGHT + (IF ARROW="↑" THEN 1 ELSE -1) ;
04500 ABOVEX ← ABOVEX MAX HEIGHT ; BELOWX ← BELOWX MIN HEIGHT ;
04600 IF POSN ≤ MAXIM OR XCRIBL THEN BEGIN EMIT(NULL) ; APPEND(FONTCHAR&ARROW) ; END ;
04700 RIPTPOSNS ← RIPTPOSNS LSH 9 LOR (POSN+LMARG) ;
04800 IF LDB(SPCODE(CHR))=LBRACK THEN BEGIN SUPERSUB ← SUPERSUB LSH 9 LOR ARROW ;
04900 AMPPOSN ← AMPPOSN LSH 9 ; COMMENT 3/28/72 ; END
05000 ELSE BEGIN EMIT(CHR) ; UNSCRIPT(ARROW) END ;
05100 END "SCRIPT" ;
00100 RECURSIVE PROCEDURE PROCESS ;
00200 BEGIN
00300 INTEGER N, CHR, F, INSET ; BOOLEAN PLUS, DONE ; STRING PIECE ; LABEL ENDERLINE ;
00400 EMPTYTHIS ; INSET ← 0 ;
00500 IF INPUTSTR = VT THEN IF ¬ON THEN LOPP(INPUTSTR) ELSE
00600 BEGIN "NEW INPUT LINE"
00700 LOPP(INPUTSTR) ;
00800 IF VERBATIM THEN BEGIN END
00900 ELSE IF INPUTSTR=CR ∧ (N←SIGNALD[CR]) THEN BEGIN LOPP(INPUTSTR) ; RESPOND(N) ; RETURN END
01000 ELSE IF ATLEAD(INSET ← LENGTH(RD(TO_NON_SP))) THEN INSET←0 ; comment AT NULL , AT <integer> ;
01100 END "NEW INPUT LINE" ;
01200 IF NOPGPH ∧ ON THEN ie, First line of paragraph ;
01300 BEGIN "START PARAGRAPH"
01400 OAKS←SPCS←TABI←PUNC←MIDWORD←SUPERSUB←ABOVEX←BELOWX←HEIGHT←FAKE←BRKABX←BRKBLX←UNDERLINING←0 ;
01500 FIRST ← NOFILL ∨ NOPGPH<0 ; STARPOSN←AMPPOSN←LASTWDBRK←0 ;
01600 INDENT ← IF FLUSHL∨VERBATIM∨CENTER∨FLUSHR THEN 0
01700 ELSE (IF NOFILL OR FIRST THEN FIRSTIM ELSE RESTIM) MAX -LMARG ;
01800 NOPGPH ← 0 ; LBK ← 3 ; LBF ← NULL ;
01900 APPEND(SPS(LMARG + INDENT)) ; POSN ← INDENT ; OKCR(TRUE) ;
02000 XPOSN ← XSPLEN(POSN) ; FSHORT ← 0 ; RKJ;
02100 IF FLUSHR THEN BOUND(2) ELSE IF CENTER THEN BOUND(1) ;
02200 FMAXIM ← (RMARG-RIGHTIM)-LMARG ;
02300 NMAXIM ← COLWID(IF AREAIXM THEN AREAIXM ELSE IXTEXT) - LMARG ;
02400 MAXIM ← IF FILL THEN FMAXIM ELSE NMAXIM ;
02500 IF VERBATIM THEN BEGIN JUSTIFY←FALSE; EMIT(RD(TO_CR_SKIP)); DBREAK ; RETURN END ;
02600 END "START PARAGRAPH" ;
02700 JUSTIFY ← FILL∧ADJUST ∨ JUSTJUST ; DONE ← FALSE ; IF INSET∧RETAIN∧¬FLUSHL THEN EMSPACES(INSET) ;
02800 DO BEGIN "SCAN TEXT"
02900 IF FULSTR("PIECE ← RD(TEXT_TBL)") THEN EMIT(PIECE) ;
03000 IF SIGNALD[BRC] ∧ SIGNA(BRC) THEN BEGIN COMMENT Responded to signal ; END
03100 ELSE CASE CHARTBL[BRC] LAND '77 OF
03200 BEGIN COMMENT BY BRC ;
03300 ie 0 ; EMIT(BRC) ;
03400 ie 1 ... CR ; BEGIN SUPERSUB←HEIGHT←AMPPOSN←RIPTPOSNS←0 ;
03500 IF FILL ∧ CRSPACE THEN EMSPACES(IF SPCS ∨ ¬POSN THEN 0 ELSE IF PUNC THEN 2 ELSE 1)
03600 ELSE IF IMPOSE THEN
03700 BEGIN "SUPERIMPOSE"
03800 IF (N ← SINCELFM+1) > TWEENLFM THEN DBREAK
03900 ELSE BEGIN EMIT(NULL); APPEND(CR & SPS(LMARG+(POSN←INDENT))); SINCELFM ← N ;
04000 TABI←MIDWORD←STARPOSN←FAKE←0 ; LBK←3; LBF←NULL; OKCR(FALSE) END ;
04100 END "SUPERIMPOSE"
04200 ELSE DBREAK ;
04300 DONE ← TRUE ;
04400 END ;
04500 ie 2 ... Altmode or { ; DONE ← TRUE ;
04600 ie 3 ... Rubout;IF ON THEN
04700 BEGIN "LABEL REF"
04800 N ← CVD(SCAN(INPUTSTR,TO_VT_SKIP,F)) ; EMIT(SPS(N)) ; OAKS←OAKS-N ; FAKE←FAKE+N ;
04900 APPEND(VT&SCAN(INPUTSTR, TO_VT_SKIP, F)&ALTMODE) ;
05000 END "LABEL REF"
05100 ELSE FOR N ← 1,2 DO SCAN(INPUTSTR, TO_VT_SKIP, F) ;
05200 ie 4 ... α ; IF INPUTSTR≠ALTMODE THEN IF (N←LOP(INPUTSTR))=CR THEN DONE←TRUE
05300 ELSE BEGIN "CHKXGP"
05400 IF XCRIBL THEN
05600 IF (F←LDB(SPCODE(N))) = XCMDCHR
05800 THEN BEGIN EMIT(N); APPEND(N) END
05900 ELSE EMIT(N)
06000 ELSE EMIT(N);
06100 END "CHKXGP";
06200 ie 5 ... β ; IF JUSTIFY THEN BEGIN OKSP(TRUE) ; OKCR(FALSE) END ELSE EMIT(BRC) ;
06300 ie 6 ... # ; IF NOT XCRIBL THEN EMIT(SP) ELSE
06320 BEGIN
06330 EMIT(NULL);
06340 IF (CHARW*MAXIM-XPOSN) ≥ CW[KSETCON+'177] THEN
06350 BEGIN
06360 APPEND(FONTCHAR); EMIT('177);
06370 END;
06380 END;
06400 ie 7 ... \ ; IF ON THEN BEGIN "NEXT TAB"
06500 DO TABI ← TABI+1 UNTIL (N ← TABSORT[TABI]) > POSN ;
06600 TABTO(N) ; IF N > NMAXIM+LMARG THEN TABI ← TABI - 1 ;
06700 END "NEXT TAB" ;
06800 ie 8 ... ∂ ; IF (CHR←INPUTSTR)=CR ∨ CHR=ALTMODE ∨ NULSTR(INPUTSTR) THEN EMIT(BRC)
06900 ELSE BEGIN "SPECIFIC TAB"
07000 CHR ← LOP(INPUTSTR) ;
07100 IF (PLUS ← CHR)="+" ∨ CHR="-" THEN CHR ← LOP(INPUTSTR) ELSE PLUS←0 ;
07200 IF CHR="(" THEN
07300 BEGIN
07400 PASS ; N ← CVD(E("0",0)) ;
07500 IF ¬ITS(")") THEN WARN("=","Missed ) after ∂(...") ;
07600 END
07700 ELSE IF (F←LDB(FAMILY(CHR)))=0 THEN N←
07800 CVD(EVALV(SYM[N←SYMNUM(CHR)], LDB(IXN(N)), LDB(TYPEN(N))))
07900 ELSE IF F = DIGQ THEN N ← CHR - 48 comment, Digit ;
08000 ELSE BEGIN WARN("=","Unintelligible ∂ Construct") ; N ← 0 END ;
08100 IF PLUS="-" THEN
08200 BEGIN comment backspace ;
08300 EMIT(NULL) ; STARPOSN ← POSN MAX STARPOSN ;
08400 POSN ← POSN-N MAX 0 ;
08500 IF XCRIBL AND XMAXIM THEN WARN("=","?* not implemented for XGP kludge"); RKJ;
08600 IF PLUS="~" ∧ ¬JUSTIFY THEN BEGIN PLUS←"-" ; N←STARPOSN-POSN END ;
08700 APPEND(FONTCHAR&PLUS&CVSR(N)) ;
08800 END
08900 ELSE IF PLUS="+" ∧ NULSTR(LBF) THEN
09000 BEGIN EMIT(NULL) ;
09100 IF N>0 THEN BEGIN APPEND(FONTCHAR&"+"&CVSR(IF XCRIBL THEN N*CHARW ELSE N));
09200 POSN←POSN+N MIN NMAXIM+LMARG END;
09300 END
09400 ELSE TABTO((IF PLUS="*" THEN STARPOSN ELSE
09500 IF PLUS="+" THEN POSN+N ELSE N) MIN NMAXIM+LMARG) ;
09600 END "SPECIFIC TAB" ;
09700 ie 9 ... ← ; IF LBK ≠ 2 THEN BOUND(1) ELSE EMIT(BRC) ;
09800 ie 10 ... → ; IF LBK ≠ 2 THEN BOUND(2) ELSE EMIT(BRC) ;
09900 ie 11 ... ∞ ; IF (N←INPUTSTR)=CR ∨ N=ALTMODE THEN WARN("=","∞ What?")
10000 ELSE BOUND(-LOP(INPUTSTR)) ;
10100 ie 12 ... ↑ ; IF ON ∧ (CHR←INPUTSTR)≠CR ∧ CHR≠ALTMODE THEN SCRIPT("↑") ELSE EMIT(BRC) ;
10300 ie 13 ... ↓ ; IF ON THEN IF (CHR←INPUTSTR)=CR ∨ CHR=ALTMODE THEN EMIT(BRC)
10400 ELSE IF (F←LDB(SPCODE(INPUTSTR)))=UNDERBAR THEN
10500 BEGIN
10600 LOPP(INPUTSTR) ; EMIT(NULL) ;
10700 IF POSN≤MAXIM OR XCRIBL THEN
10800 BEGIN
10900 IF UNDERLINING=0 THEN APPEND(FONTCHAR&"_");
11100 UNDERLINING←2;
11200 END;
11300 END
11310 ELSE IF F=KSETSWAP THEN
11320 BEGIN
11330 LOPP(INPUTSTR); EMIT(NULL);
11335 IF NOT XCRIBL THEN WARN("=","KSETSWAP in non-XCRIBL mode - ignored") ELSE
11340 APPEND(FONTCHAR & (IF (KSETCON←128-KSETCON) = 0 THEN "A" ELSE "B"));
11350 END
11400 ELSE SCRIPT("↓") ;
11600 ie 14 ... ] ; IF SUPERSUB AND ON THEN UNSCRIPT(0)
11700 ELSE EMIT(BRC) ;
11800 ie 15 ... hyphen ; IF MIDWORD AND FILL AND ON AND ¬SUPERSUB THEN
11900 BEGIN
12000 EMIT("-") ; OKCR(FALSE) ;
12100 IF INPUTSTR=CR THEN BEGIN LOPP(INPUTSTR); DONE←TRUE END ;
12200 END
12300 ELSE BEGIN N←MIDWORD ; EMIT(BRC) ; MIDWORD ← N END ;
12400 ie 16 ... .!? ; IF MIDWORD∧FILL∧ON∧¬SUPERSUB THEN BEGIN EMIT(BRC) ; PUNC←TRUE END
12500 ELSE EMIT(BRC) ;
12600 ie 17 ... space ; EMSPACES(1 + LENGTH(RD(TO_NON_SP)) ) ;
12700 ie 18 ... underline ; IF LDB(SPCODE(INPUTSTR))=DARROW AND ON THEN
12800 BEGIN
12900 LOPP(INPUTSTR) ; EMIT(NULL) ;
13000 IF UNDERLINING THEN
13100 ENDERLINE: BEGIN
13200 UNDERLINING ← 0 ;
13300 IF POSN≤MAXIM OR XCRIBL THEN APPEND(FONTCHAR&"≡");
13500 END ;
13600 END
13700 ELSE BEGIN
13800 EMIT(NULL) ;
13900 IF POSN<MAXIM OR XCRIBL THEN BEGIN APPEND(FONTCHAR&"π") ; EMIT(BRC) END ;
14000 END ;
14100 ie 19 ... π ; BEGIN
14200 IF (CHR ← INPUTSTR) = "g" THEN CHR ← "G" ;
14300 IF CHR="G" ∨ CHR="." ∨ CHR="∂" ∨ CHR="+" ∨ CHR="-" ∨ CHR="~" THEN
14400 BEGIN
14500 EMIT(NULL) ;
14600 IF ON ∧ (POSN<MAXIM OR XCRIBL) THEN
14700 BEGIN APPEND(FONTCHAR&"π") ; EMIT(CHR) END ;
14800 LOPP(INPUTSTR) ;
14900 END
15000 ELSE EMIT(BRC) ;
15100 END ;
15200 ie 20 ... ∪ ; IF ON ∧ UNDERLINING=0 THEN
15300 BEGIN COMMENT ∪NDERLINE ONE WORD ;
15400 EMIT(NULL) ; UNDERLINING ← 1 ;
15500 IF POSN<MAXIM OR XCRIBL THEN APPEND(FONTCHAR & "_");
15700 IF FULSTR("PIECE←RD(ALPHA)") THEN EMIT(PIECE) ;
15800 GO TO ENDERLINE ;
15900 END ;
16000 ie 21 ... ∩ ; EMIT(BRC) ; COMMENT CURRENTLY NOT USED ;
16100 ie 22 ... VT ; WARN("=", "`⊃' SEEMS TO BE ON TEXT LINE IN MACRO") ;
16200 ie 23 ... ⊗ ; EMIT(BRC) ; COMMENT DOXAP ESCAPE CHARACTER, NO SPECIAL PUB ACTION;
16210 ie 24 ... % ; IF ON THEN
16230 IF LDB(SPCODE(INPUTSTR))=DARROW THEN
16240 BEGIN
16250 LOPP(INPUTSTR); EMIT(NULL);
16255 IF NOT XCRIBL THEN WARN("=","KSETSWAP in non-XCRIBL mode - ignored") ELSE
16260 APPEND(FONTCHAR & (IF (KSETCON←128-KSETCON) = 0 THEN "A" ELSE "B"));
16270 END;
16300 END ; COMMENT BY BRC ;
16400 END "SCAN TEXT" UNTIL DONE ;
16500 END "PROCESS " ;
00100 INTERNAL RECURSIVE BOOLEAN PROCEDURE TEXTLINE ;
00200 BEGIN
00300 PRELOAD_WITH 6, [8]0, 1, [2]0, 5, 0, 3, [4]4, [6]0, 4, 2, 4, 2, [2]0 ;
00400 OWN INTEGER ARRAY TEXTTYPE[-15:15] ;
00500 BOOLEAN IMITEXT ; INTEGER USYMB, LEN ; STRING STR ;
00600 IMITEXT ← TRUE ; comment assume computed text line ;
00700 CASE TEXTTYPE[THISTYPE] OF
00800 BEGIN COMMENT BY TYPE ;
00900 ie 0 ... Invalid ; RETURN(FALSE) ;
01000 ie 1 ... [ ; BEGIN comment [Est] Label or [@] rubout gen-label ; PASS ;
01100 IF ITS(@) THEN BEGIN PASS ; IMITEXT ← FALSE END
01200 ELSE BEGIN LEN ← CVD(E("5", 0)) ;
01300 IF ITS("]") THEN PASS ELSE WARN("=","Missed ] after label length") ;
01400 THISWD ← LABELREF(0, LEN) ; END ;
01500 END ;
01600 ie 2 ... Unit ; IF THATISID THEN
01700 BEGIN comment Unit Label ;
01800 USYMB ← SYMB ;
01900 LEN ← IF THISTYPE=PUNITTYPE THEN PATT_CHRS(IX) ELSE CTR_CHRS(IX) ;
02000 PASS ; THISWD ← LABELREF(USYMB, LEN) ;
02100 END
02200 ELSE IF IX=IXPAGE THEN
02300 BEGIN comment, Generate a label ;
02400 THISWD ← NULL ;
02500 THISWD ← LABELREF(0, IF ITS(PAGE) THEN CTR_CHRS(IXPAGE) ELSE PATT_CHRS(IXPAGE)) ;
02600 END
02700 ELSE THISWD ← VEVAL ;
02800 ie 3 ... Constant ;
02900 BEGIN
03000 LOPP(THISWD) ;
03100 IF THATISID ∧ SIMLOOK(CAPITALIZE(STR←SCAN(THISWD,ALPHA,DUMMY)))
03200 ∧ (SYMTYPE = UNITTYPE ∨ SYMTYPE = PUNITTYPE) THEN
03300 BEGIN comment "Unit.." Label ;
03400 STR ← IF SYMTYPE=PUNITTYPE THEN THISWD[1 TO ∞-1] ELSE THISWD ; USYMB ← SYMBOL ;
03500 LEN ← IF SYMTYPE=PUNITTYPE THEN PATT_CHRS(SYMIX) ELSE CTR_CHRS(SYMIX) ;
03600 PASS ; THISWD ← STR & SP & LABELREF(USYMB, LEN) ;
03700 END ;
03800 END ;
03900 ie 4 ... Variable ; THISWD ← VEVAL ;
04000 ie 5 ... ⎇ etc. ; IF IX comment not ⎇ ; THEN RETURN(FALSE) ELSE IMITEXT←FALSE ;
04100 CMU CHANGE: STANFORD 176 WENT TO CMU 175 ABOVE;
04200 ie 6 ... misc ; IF ITS("(") THEN BEGIN PASS; STR←E(NULL,NULL);
04300 IF ¬ITS(")") THEN WARN("=","Parens don't match") ; THISWD←STR END ELSE RETURN(FALSE) ;
04400 END ; COMMENT BY TYPE ;
04500 IF IMITEXT THEN IF NULSTR(THISWD) OR ¬ON THEN ELSE
04600 BEGIN
04700 BEGINBLOCK(FALSE, 0, "!NAKED") ;
04800 SWICH(THISWD&ALTMODE&" END ""!NAKED""", -1, 0) ;
04900 PROCESS ;
05000 END
05100 ELSE PROCESS ;
05200 PASS ;
05300 RETURN(TRUE) ;
05400 END "TEXTLINE" ;
00100 END "INNER BLOCK" ;
00200 END "FILLER"